home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD School House 10
/
CD School House - Education and Games (10.0) - Wayzata Technology (1995).iso
/
mac
/
DOS
/
MISC
/
ESPTEST
/
ESPTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-20
|
60KB
|
1,623 lines
{$U+}
{$B-}
{$I-}
{**********************************************************}
{** **}
{** ESPTEST Version 1.0 **}
{** **}
{** A program to test esp **}
{** **}
{** Copyright 1991 Phil Mosier **}
{** **}
{** This program will lead a subject through a **}
{** a test of their ESP and give a statistical **}
{** evaluation of their performance **}
{** **}
{** Turbo Pascal Version 4.0 **}
{** **}
{**********************************************************}
Program ESPTEST;
Uses Graph,
Dos,
Crt,
ESPDRIVR,
ESPFONT,
ESPIMAGE,
ESPSCORE,
ESPPROB;
Const BACK_SPACE = #8;
Const RETURN = #13;
Const SPACE = #32;
Const FF = #12; {Form Feed}
Type FILE_NAME_TYPE = String[15];
Type PARAM_RECORD = Record
GRAPH_MODE : Integer;
BACK_COLOR : Integer;
COLOR_OF_CARD : Char;
GUESS_FILE_NAME : FILE_NAME_TYPE;
SOUND_REINFORCE : Integer;
VISUAL_REINFORCE : Integer;
TYPE_TESt : Char;
End;
Type PARAM_FILE_TYPE = File of PARAM_RECORD;
Type STRING30 = String[30];
Type STRING25 = String[25];
Type SELECT_ARRAY = Array[1..5] of Integer;
Var PARAM_DATA : PARAM_RECORD;
GRAPHDRIVER : Integer;
MODE : Integer;
ERRORCODE : Integer;
DRIVER : Integer;
CURSOR : Pointer;
OLD_SCREEN : Pointer;
MENU_SCREEN : Pointer;
CUR_CARD : Pointer;
CARD_1 : Pointer;
CARD_2 : Pointer;
CARD_3 : Pointer;
CARD_4 : Pointer;
CARD_5 : Pointer;
SELECT_1 : Pointer;
SELECT_2 : Pointer;
SELECT_3 : Pointer;
SELECT_4 : Pointer;
SELECT_5 : Pointer;
BACK_OF_CARD : Pointer;
BLANK_CARD : Pointer;
ANSWER_CHAR: Char;
REAL_STRING : string[7];
WORK_REAL : Real;
Procedure USE_ROMAN_FONT;
{**********************************************************}
{** **}
{**********************************************************}
Begin
SetUserCharSize(25,32,9,16);
SetTextStyle(TriplexFont,horizdir,UserCharSize);
End;
Procedure USE_SMALL_FONT;
{**********************************************************}
{** **}
{**********************************************************}
Begin
SetUserCharSize(1,1,1,1);
SetTextStyle(SmallFont,HorizDir,UserCharSize);
End;
Procedure ERROR(MESSAGE: STRING30);
{**********************************************************}
{** **}
{**********************************************************}
Begin
GetImage(0,0,319,199,OLD_SCREEN^);
Cleardevice;
USE_ROMAN_FONT;
Moveto(20,100);
OutText(MESSAGE);
If ((PARAM_DATA.SOUND_REINFORCE = 1) Or
(PARAM_DATA.SOUND_REINFORCE = 2) Or
(PARAM_DATA.SOUND_REINFORCE = 3)) Then
Begin
Sound(440);
Delay(500);
NoSound;
End;
If ((PARAM_DATA.SOUND_REINFORCE = 1) Or
(PARAM_DATA.SOUND_REINFORCE = 2) Or
(PARAM_DATA.SOUND_REINFORCE = 3)) Then
Delay(1500)
Else Delay(2000);
ClearDevice;
PutImage(0,0,OLD_SCREEN^,NormalPut);
End;
Procedure INITIALIZE;
{************************************************}
{** **}
{** This procedure initializes the computer **}
{** setings **}
{** **}
{************************************************}
Var PARAM_FILE : PARAM_FILE_TYPE;
IOCODE: Integer;
NOTICE : String[26];
Begin; {Display_title }
NOTICE := (' (C) 1991 by Phil Mosier ');
If RegisterBGIdriver(@CGADriverProc) < 0 Then
Begin
WriteLn('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
End;
If RegisterBGIFont(@TriplexFontProc) < 0 Then
Begin
WriteLn('Error registering font: ',
GraphErrorMsg(GraphResult));
Halt(1);
End;
If RegisterBGIFont(@SmallFontProc) < 0 Then
Begin
WriteLn('Error registering font: ',
GraphErrorMsg(GraphResult));
Halt(1);
End;
GRAPHDRIVER := Detect;
DRIVER := CGA;
MODE := CGAC1;
InitGraph (DRIVER, MODE, '');
ERRORCODE := GraphResult;
If ERRORCODE <> GrOK Then
Begin
WriteLn('Graphics error : ', GraphErrorMsg(ERRORCODE));
WriteLn('(You probably don''t have a graphics card!)');
WriteLn('Program aborted...');
Halt(1);
End;
ASSIGN(PARAM_FILE,'ESPPARAM.DAT');
{$I-}
ReSet(PARAM_FILE);
{$I+}
IOCODE := IOResult;
If IOCODE <> 0 Then
If IOCODE = 2 Then
Begin
MoveTo(0,20);
OutText('Opening New File');
Delay(5000);
PARAM_DATA.GRAPH_MODE := 1;
PARAM_DATA.BACK_COLOR := 1; {Blue}
PARAM_DATA.COLOR_OF_CARD := '2';
PARAM_DATA.GUESS_FILE_NAME := 'NONAME.ESP';
PARAM_DATA.SOUND_REINFORCE := 1;
PARAM_DATA.VISUAL_REINFORCE := 1;
PARAM_DATA.TYPE_TEST := 'C';
{$I-}
ReWrite(PARAM_FILE);
IOCODE := IoResult;
{$i+}
If IOCODE <> 0 Then Begin
MoveTo(0,40);
OutText('Unable to write file!');
Delay(1500);
End
Else
Begin
Write(PARAM_FILE,PARAM_DATA);
Close(PARAM_FILE);
End
End
Else
Begin
MoveTo(10,30);
OutText('Disk problems');
Delay(5000);
Halt(1);
End
Else
Begin { If IOCODE = 0 }
Read(PARAM_FILE,PARAM_DATA);
Close(PARAM_FILE);
End;
SetGraphMode(PARAM_DATA.GRAPH_MODE);
SetBkColor(PARAM_DATA.BACK_COLOR);
SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
GetMem(CURSOR,ImageSize(1,1,8,10));
GetImage(1,1,8,10,CURSOR^);
GetMem(OLD_SCREEN,ImageSize(0,0,319,199));
GetMem(MENU_SCREEN,imagesize(0,0,319,199));
GetMem(CUR_CARD,ImageSize(0,0,60,90));
GetMem(CARD_1,ImageSize(0,0,60,90));
GetMem(CARD_2,ImageSize(0,0,60,90));
GetMem(CARD_3,ImageSize(0,0,60,90));
GetMem(CARD_4,ImageSize(0,0,60,90));
GetMem(CARD_5,ImageSize(0,0,60,90));
GetMem(SELECT_1,ImageSize(0,0,26,26));
GetMem(SELECT_2,ImageSize(0,0,26,26));
GetMem(SELECT_3,ImageSize(0,0,26,26));
GetMem(SELECT_4,ImageSize(0,0,26,26));
GetMem(SELECT_5,ImageSize(0,0,26,26));
GetMem(BLANK_CARD,ImageSize(0,0,60,90));
GetMem(BACK_OF_CARD,ImageSize(0,0,60,90));
GetImage(0,0,60,90,BLANK_CARD^);
END; {Display_title }
Procedure TITLE;
{************************************************}
{** **}
{** This procedure prints the title of the **}
{** program **}
{** **}
{************************************************}
BEGIN; {Display_title }
USE_ROMAN_FONT;
MoveTo(0,0);
OutText(' E S P T E S T');
Use_Small_Font;
Moveto(190,0);
OutText('(C) 1991 Phil Mosier ');
MoveTo(190,10);
Line(90,70,150,70); { card back }
Line(90,70,90,160);
Line(150,70,150,160);
Line(90,160,150,160);
SetFillStyle(6,GetMaxColor);
FloodFill(95,75,GetMaxColor);
GetImage(90,70,150,160,BACK_OF_CARD^);
SetFillStyle(SolidFill,GetMaxColor);
Delay(1000);
PutImage(90,70,BLANK_CARD^,3);
Delay(2000);
Line(90,70,150,70); { card 1 }
Line(90,70,90,160);
Line(150,70,150,160);
Line(90,160,150,160);
Image_1(95,90,1.0);
GetImage(90,70,150,160,CARD_1^);
Delay(700);
PutImage(130,40,BLANK_CARD^,3);
Line(130,40,190,40); { card 2 }
Line(130,40,130,130);
Line(190,40,190,130);
Line(130,130,190,130);
Image_2(135,60,1.0);
GetImage(130,40,190,130,CARD_2^);
Delay(1600);
PutImage(45,25,BLANK_CARD^,3);
Line(45,25,105,25); { card 3 }
Line(45,25,45,115);
Line(105,25,105,115);
Line(45,115,105,115);
IMAGE_3(50,45,1.0);
GetImage(45,25,105,115,CARD_3^);
Delay(800);
PutImage(220,70,BLANK_CARD^,3);
Line(220,70,280,70); { card 4 }
Line(220,70,220,160);
Line(280,70,280,160);
Line(220,160,280,160);
IMAGE_4(225,90,1.0);
GetImage(220,70,280,160,CARD_4^);
Delay(800);
PutImage(175,20,BLANK_CARD^,3);
Line(175,20,235,20); { card 5 }
Line(175,20,175,110);
Line(235,20,235,110);
Line(175,110,235,110);
IMAGE_5(180,40,1.0);
GetImage(175,20,235,110,card_5^);
Delay(1600);
MoveTo(0,185);
If ((PARAM_DATA.SOUND_REINFORCE = 1) Or
(PARAM_DATA.SOUND_REINFORCE = 2) Or
(PARAM_DATA.SOUND_REINFORCE = 3)) Then
SONG;
OutText('Press any key ');
ANSWER_CHAR := ReadKey;
END; {Display_title }
Procedure MAIN_MENU(Var MAIN_SELECTION : Char );
{**********************************************************}
{** **}
{** **}
{**********************************************************}
Procedure GET_STRING(Var X_PLACE : Integer;
Var Y_PLACE : Integer;
Var INPUT_INDEX : Byte;
Var INPUT_STRING : STRING25;
Var RETURN_ON : Boolean;
STRING_LENGTH : Byte);
{******************* Get String ******************}
Var EXIT_FLAG : Boolean;
OKAY_FLAG : Boolean;
ANSWER_CHAR : Char;
SHORT_CASE_FLAG : Boolean;
SAVE_INDEX : Byte;
Begin
USE_SMALL_FONT;
EXIT_FLAG :=False;
RETURN_ON := False;
INPUT_STRING := ' ';
INPUT_INDEX := 1;
Repeat
PutImage(X_PLACE,Y_PLACE,CURSOR^,4);
OKAY_FLAG := False;
Repeat
ANSWER_CHAR := UpCase(Readkey);
OKAY_FLAG := True;
If (ANSWER_CHAR In ['.','"','/','\','[',']',':',
';','|','<','>','+','=',',','*','?'])
Then begin
OKAY_FLAG := False;
ERROR('Not a valid character');
USE_SMALL_FONT
End;
If Not (ANSWER_CHAR In ['A'..'Z','a'..'z','0'..'9',
'-','_','(',')','&','^','%','$','#','@','!',
'{','}',BACK_SPACE,RETURN])
Then Begin
OKAY_FLAG := False;
ERROR('Not a valid character');
USE_SMALL_FONT
End;
Until OKAY_FLAG;
If (ANSWER_CHAR = BACK_SPACE)
Then Begin
If INPUT_INDEX = 1 Then
Begin
EXIT_FLAG := True;
RETURN_ON := True;
End;
If INPUT_INDEX > 1 Then
Begin
INPUT_INDEX := INPUT_INDEX - 1;
INPUT_STRING[INPUT_INDEX] := ' ';
PutImage(X_PLACE,Y_PLACE,CURSOR^,3);
X_PLACE := X_PLACE - 6;
PutImage(X_PLACE,Y_PLACE,CURSOR^,4);
End;
End
Else
Begin
If ANSWER_CHAR <> RETURN Then
Begin
PutImage(X_PLACE,Y_PLACE,CURSOR^,3);
MoveTo(X_PLACE,Y_PLACE);
OutText(ANSWER_CHAR);
INPUT_STRING[INPUT_INDEX] := ANSWER_CHAR;
X_PLACE := X_PLACE + 6;
INPUT_INDEX := INPUT_INDEX + 1;
PutImage(X_PLACE,Y_PLACE,CURSOR^,4);
End;
End;
SHORT_CASE_FLAG := False;
If INPUT_INDEX < 3 Then
Begin
SAVE_INDEX := INPUT_INDEX;
INPUT_INDEX := 3;
SHORT_CASE_FLAG := True;
End;
If (((INPUT_STRING[INPUT_INDEX - 2] = ' ') And
(ANSWER_CHAR = ' ') And (Not SHORT_CASE_FLAG)) Or
(INPUT_INDEX > STRING_LENGTH) Or
(ANSWER_CHAR = RETURN )) Then
Begin
EXIT_FLAG := True;
End;
If SHORT_CASE_FLAG Then INPUT_INDEX := SAVE_INDEX;
If ((INPUT_INDEX = 1) And (ANSWER_CHAR = RETURN)) Then
Begin
EXIT_FLAG := True;
RETURN_ON := True;
End;
Until EXIT_FLAG;
PutImage(X_PLACE,Y_PLACE,CURSOR^,3);
End; {GET_STRING}
Procedure CHANGE_DEFAULTS(Var CHANGE_SELECTION:Char);
{**********************************************************}
{** **}
{** CHANGE_DEFAULTS **}
{** **}
{**********************************************************}
Var PARAM_FILE : PARAM_FILE_TYPE;
IOCODE : integer;
SUB_ANSWER : Char;
OKEY_FLAG : Boolean;
NEW_STRING_FLAG : Boolean;
TOP_NUM : Char;
BOTTEM_NUM : Char;
INPUT_NUM : Byte;
TEMP_STRING3 : String[3];
TEMP_STRING8 : String[8];
LETTER_COUNT : Integer;
EXIT_FLAG : Boolean;
TEMP_LESSON_FILE_NAME : FILE_NAME_TYPE;
X_PLACE : Integer;
Y_PLACE : Integer;
STRING_LENGTH : Byte;
INPUT_INDEX : Byte;
INPUT_STRING : STRING25;
RETURN_ON : Boolean;
Begin
ClearDevice;
USE_ROMAN_FONT;
MoveTo(0,0);
OutText('C Color is');
MoveTo(130,0);
Case PARAM_DATA.BACK_COLOR Of
4 : OutText('RED');
1 : OutText('BLUE');
0 : OutText('BLACK');
End;
MoveTo(0,20);
OutText('S Sound Reinforcing ' );
MoveTo(255,20);
Case PARAM_DATA.SOUND_REINFORCE Of
1 : OutText('ALL ');
2 : OutText('HIT ');
3 : OutText('MISS');
4 : OutText('NONE');
End;
MoveTo(0,40);
OutText('V Visual Reinforcing ');
MoveTo(255,40);
Case PARAM_DATA.VISUAL_REINFORCE Of
1 : OutText('ALL ');
2 : OutText('HIT ');
3 : OutText('MISS');
4 : OutText('NONE');
End;
MoveTo(0,60);
OutText('T Type is');
MoveTo(130,60);
If PARAM_DATA.TYPE_TEST = 'C' Then
OutText('CLARIVOYANCE')
Else
OutText('PRECOGNITION');
MoveTo(0,80);
OutText('F File of scores');
MoveTo(50,100);
OutText(PARAM_DATA.GUESS_FILE_NAME);
MoveTo(0,120);
OutText('Q Quit');
Line(0,140,310,140);
OKEY_FLAG := False;
Repeat
ANSWER_CHAR := Readkey;
ANSWER_CHAR := UpCase(ANSWER_CHAR);
If (ANSWER_CHAR In ['C','S','V','T','F','Q'])
Then OKEY_FLAG := True
Else ERROR(' not C, S, V, T, F, or Q');
Until OKEY_FLAG;
CHANGE_SELECTION := ANSWER_CHAR;
USE_SMALL_FONT;
Case ANSWER_CHAR Of
'C': Begin
MoveTo(0,150);
OutText('Do you want: 1 RED');
MoveTo(75,160);
OutText(' 2 BLUE');
MoveTo(75,170);
OutText(' 3 BLACK');
OKEY_FLAG := False;
Repeat
SUB_ANSWER := ReadKey;
If (SUB_ANSWER In ['1','2','3']) Then
OKEY_FLAG := True
Else ERROR('not 1 2 or 3');
Until OKEY_FLAG;
PARAM_DATA.GRAPH_MODE := 1;
Case SUB_ANSWER Of
'1' : Begin
PARAM_DATA.BACK_COLOR := 4;
PARAM_DATA.COLOR_OF_CARD := '1';
End;
'2' : Begin
PARAM_DATA.BACK_COLOR := 1;
PARAM_DATA.COLOR_OF_CARD := '2';
End;
'3' : Begin
PARAM_DATA.BACK_COLOR := 0;
PARAM_DATA.COLOR_OF_CARD := '3';
End;
End;
End;
'S': Begin
MoveTo(0,150);
OutText('Do you want a Sound to tell when you''re right?');
MoveTo(220,160);
OutText('1 ALL ');
MoveTo(220,170);
OutText('2 HIT ');
MoveTo(220,180);
OutText('3 MISS');
MoveTo(220,190);
OutText('4 NONE');
OKEY_FLAG := False;
Repeat
SUB_ANSWER := ReadKey;
If (SUB_ANSWER In ['1','2','3','4']) Then
Begin
Case SUB_ANSWER of
'1': PARAM_DATA.SOUND_REINFORCE := 1;
'2': PARAM_DATA.SOUND_REINFORCE := 2;
'3': PARAM_DATA.SOUND_REINFORCE := 3;
'4': PARAM_DATA.SOUND_REINFORCE := 4;
End;
OKEY_FLAG := True;
End
Else ERROR('not 1, 2, 3 or 4');
Until OKEY_FLAG;
End;
'V': Begin
MoveTo(0,150);
OutText('Do you want to see if you''re right?');
MoveTo(220,160);
OutText('1 ALL ');
MoveTo(220,170);
OutText('2 HIT ');
MoveTo(220,180);
OutText('3 MISS');
MoveTo(220,190);
OutText('4 NONE');
OKEY_FLAG := False;
Repeat
SUB_ANSWER := ReadKey;
If (SUB_ANSWER In ['1','2','3','4']) Then
Begin
Case SUB_ANSWER Of
'1': PARAM_DATA.VISUAL_REINFORCE := 1;
'2': PARAM_DATA.VISUAL_REINFORCE := 2;
'3': PARAM_DATA.VISUAL_REINFORCE := 3;
'4': PARAM_DATA.VISUAL_REINFORCE := 4;
End;
OKEY_FLAG := True;
End
Else ERROR(' not 1, 2, 3 or 4');
Until OKEY_FLAG ;
End;
'T': Begin
MoveTo(0,150);
OutText('What Type of test do you want?');
MoveTo(220,170);
OutText('1 CLARIVOYANCE');
MoveTo(220,180);
OutText('2 PRECOGNITION');
OKEY_FLAG := False;
Repeat
SUB_ANSWER := ReadKey;
If (SUB_ANSWER In ['1','2']) Then
Begin
Case SUB_ANSWER Of
'1': PARAM_DATA.TYPE_TEST := 'C';
'2': PARAM_DATA.TYPE_TEST := 'P';
End;
OKEY_FLAG := True;
End
Else ERROR(' not 1 OR 2');
Until OKEY_FLAG;
End;
'F': Begin
TEMP_LESSON_FILE_NAME := PARAM_DATA.GUESS_FILE_NAME;
PARAM_DATA.GUESS_FILE_NAME :=
' ';
MoveTo(0,150);
OutText('Enter the file name for scores to be saved.');
MoveTo(0,160);
OutText('Name could be up to 8 letters long');
MoveTo(120,170);
OutText('12345678');
NEW_STRING_FLAG := False;
EXIT_FLAG := False;
Repeat
X_PLACE := 120;
Y_PLACE := 180;
STRING_LENGTH := 8;
GET_STRING(X_PLACE,Y_PLACE,INPUT_INDEX,INPUT_STRING,
RETURN_ON, STRING_LENGTH);
TEMP_STRING8 := INPUT_STRING;
If Not RETURN_ON Then
NEW_STRING_FLAG := True;
If RETURN_ON THEN
Begin
PutImage(X_PLACE,Y_PLACE,CURSOR^,3);
X_PLACE := 192;
For LETTER_COUNT := 8 DownTo 1 Do
Begin
X_PLACE := X_PLACE - 8;
PutImage(X_PLACE,Y_PLACE,CURSOR^,3);
End;
NEW_STRING_FLAG :=False;
End;
If NEW_STRING_FLAG Then
Begin
If (Pos(' ',TEMP_STRING8) = 0) Then
PARAM_DATA.GUESS_FILE_NAME :=
TEMP_STRING8+'.ESP';
If (Pos(' ',TEMP_STRING8) > 0) Then
PARAM_DATA.GUESS_FILE_NAME :=
Concat(Copy(TEMP_STRING8,1,
(Pos(' ',TEMP_STRING8)) -1),'.ESP');
End
Else
Begin
EXIT_FLAG := True;
PARAM_DATA.GUESS_FILE_NAME := TEMP_LESSON_FILE_NAME;
End;
Until (EXIT_FLAG Or NEW_STRING_FLAG);
End;
'Q': CHANGE_SELECTION := 'Q';
End;
If ANSWER_CHAR = 'Q' Then
Begin
Assign(PARAM_FILE,'ESPPARAM.DAT');
{$I-}
ReWrite(PARAM_FILE);
{$I+}
IOCODE := IoResult;
If IOCODE <> 0 Then
Begin
ERROR ('Disk problems writing file');
Delay(1000);
MAIN_SELECTION := 'Q';
End
Else Begin
Write(PARAM_FILE,PARAM_DATA);
Close(PARAM_FILE);
End
End;
SetGraphMode(PARAM_DATA.GRAPH_MODE);
SetBkColor(PARAM_DATA.BACK_COLOR);
End; {CHANGE_DEFAULTS}
Procedure TEST(Var TEST_SELECTION : Char);
{**********************************************************}
{** **}
{** Declaration of TEST **}
{** **}
{**********************************************************}
Procedure RANDOM_SELECTS(Var SELECTS_RAND_NOS:SELECT_ARRAY);
{**********************************************************}
{** **}
{**********************************************************}
Var TEMP : Integer;
SELECTS_INDEX : Integer;
LIST : Array[1..5] of Integer;
Begin
USE_SMALL_FONT;
MoveTo(44,164);
OutText('1 2 3 4 5 Q');
MoveTo(250,183);
OutText('QUIT');
Line(40,160,280,160);
Line(40,160,40,199);
Line(80,160,80,199);
Line(120,160,120,199);
Line(160,160,160,199);
Line(200,160,200,199);
Line(240,160,240,199);
Line(280,160,280,199);
Line(40,199,280,199);
Randomize;
For TEMP := 5 DownTo 1 Do
LIST[TEMP]:= TEMP;
{*** PULLS NUMBERS FROM LIST[1..5] AT RANDOM AND PUTS THEM **}
{** IN SELECTS_RAND_NOS[1..5] **}
For TEMP := 5 DownTo 1 Do
Begin
SELECTS_INDEX := Random(TEMP) + 1;
SELECTS_RAND_NOS[TEMP] := LIST[SELECTS_INDEX];
If SELECTS_INDEX < 5 Then
Begin
Repeat
SELECTS_INDEX := SELECTS_INDEX + 1;
LIST[SELECTS_INDEX - 1] := LIST[SELECTS_INDEX]
Until SELECTS_INDEX = 5;
End
End;
{*** THIS PUTS THE IMAGES IN POSITIONS DISCRIBED BY THE VALUES IN **}
{*** SELECTS_RAND_NOS[1..5] **}
For Temp := 1 To 5 Do
Begin
Case SELECTS_RAND_NOS[TEMP] Of
1 : PutImage((10 + (TEMP * 40)),172,SELECT_1^,0);
2 : PutImage((10 + (TEMP * 40)),172,SELECT_2^,0);
3 : PutImage((10 + (TEMP * 40)),172,SELECT_3^,0);
4 : PutImage((10 + (TEMP * 40)),172,SELECT_4^,0);
5 : PutImage((10 + (TEMP * 40)),172,SELECT_5^,0);
End; { Case }
End;
End;
Procedure LAY_DOWN(Var POSITION : Integer);
{**********************************************************}
{** **}
{**********************************************************}
Begin
POSITION := POSITION + (Random(2) + 1);
If POSITION > 3 Then POSITION := POSITION - 3;
Case POSITION Of
1 : PutImage(130,40,BACK_OF_CARD^,0);
2 : PutImage(220,60,BACK_OF_CARD^,0);
3 : PutImage(175,20,BACK_OF_CARD^,0);
End ;
End;
{**********************************************************}
{** Body of TEST **}
{**********************************************************}
Var TEST_CHOICE : Char;
OKAY_FLAG : Boolean;
TEST_INDEX : Integer;
SELECTS_RAND_NOS : SELECT_ARRAY;
TARGET : Integer;
POSITION : Integer;
SHOW_POS : Integer;
X_POS : Integer;
Y_POS : Integer;
INDEX : Integer;
INDEX2 : Integer;
HIT_FLAG : Boolean;
TEST_CALL : Integer;
TEMP : String[2];
D_GUESS : Char;
D_HIT_MISS : Char;
D_START_HOUR : Word;
D_START_MIN : Word;
D_START_SEC : Word;
D_START_100_SEC : Word;
END_HOUR : Word;
END_MIN : Word;
END_SEC : Word;
END_100_SEC : Word;
CARRY_HOUR : Word;
CARRY_MIN : Word;
D_CUR_YEAR : Word;
D_CUR_MONTH : Word ;
D_CUR_DAY : Word ;
D_COLOR_OF_CARD : Char;
D_SCREEN_DISPLAY1 : Char ;
D_SCREEN_DISPLAY2 : Char ;
D_SCREEN_DISPLAY3 : Char ;
D_SCREEN_DISPLAY4 : Char ;
D_SCREEN_DISPLAY5 : Char ;
D_REINFORCE_VISUAL : Char;
D_REINFORCE_SOUND : Char;
D_STYLE : Char;
D_ELAPESED_SEC : LongInt;
CUR_DAYOFWEEK : Word ;
ELAPESED_HOUR : Word ;
ELAPESED_MIN : Word ;
ELAPESED_SEC : Word ;
D_TARGET : Char;
D_NAME1 : Char;
D_NAME2 : Char;
D_NAME3 : Char;
D_NAME4 : Char;
D_NAME5 : Char;
D_NAME6 : Char;
D_NAME7 : Char;
D_NAME8 : Char;
WRITE_OK : Boolean;
Begin {TEST}
Randomize;
POSITION := 1;
TEST_CALL := 0;
ClearDevice;
Repeat
TEST_CALL := TEST_CALL + 1;
RANDOM_SELECTS(SELECTS_RAND_NOS);
If PARAM_DATA.TYPE_TEST = 'C' Then
Begin
TARGET := Random(5) + 1;
LAY_DOWN(POSITION);
End;
GetTime(D_START_HOUR,D_START_MIN,D_START_SEC,D_START_100_SEC);
GetDate(D_CUR_YEAR,D_CUR_MONTH,D_CUR_DAY,CUR_DAYOFWEEK);
OKAY_FLAG := False;
Repeat
TEST_CHOICE := UpCase(ReadKey);
If TEST_CHOICE In ['1','2','3','4','5','Q'] Then
OKAY_FLAG := True
Else
ERROR(' Must be 1 2 3 4 5 or Q ');
Until OKAY_FLAG;
GetTime(END_HOUR,END_MIN,END_SEC,END_100_SEC);
CARRY_MIN := 0;
CARRY_HOUR := 0;
ELAPESED_SEC := 0;
ELAPESED_MIN := 0;
ELAPESED_HOUR := 0;
If END_SEC < D_START_SEC Then
Begin
CARRY_MIN := 1;
ELAPESED_SEC := 60 + END_SEC - D_START_SEC;
End
Else
ELAPESED_SEC := END_SEC - D_START_SEC;
If END_MIN < D_START_MIN Then
Begin
CARRY_HOUR := 1;
ELAPESED_MIN := 60 + END_MIN - D_START_MIN -
CARRY_MIN;
END
Else
ELAPESED_MIN := END_MIN - D_START_MIN - CARRY_MIN;
If END_HOUR < D_START_HOUR Then
Begin
{ NO WAY TO DEAL WITH PAUSES GREATER THAN 24 HR }
ELAPESED_HOUR := 24 + END_HOUR - D_START_HOUR -
CARRY_HOUR;
End
Else
ELAPESED_HOUR := END_HOUR - D_START_HOUR - CARRY_HOUR;
ELAPESED_SEC := (ELAPESED_HOUR * 3600)
+ (ELAPESED_MIN * 60)
+ ELAPESED_SEC;
If TEST_CHOICE <> 'Q' Then
Begin
If (PARAM_DATA.TYPE_TEST = 'P') Then
Begin
TARGET := Random(5) + 1;
LAY_DOWN(POSITION);
Delay(500);
End;
Case POSITION Of
1 : PutImage(130,40,BLANK_CARD^,3);
2 : PutImage(220,60,BLANK_CARD^,3);
3 : PutImage(175,20,BLANK_CARD^,3);
End ;
SHOW_POS := Random(2) + 1;
If SHOW_POS = 1 Then
Begin
X_POS := 90;
Y_POS := 60;
End
Else
Begin
X_POS := 45;
Y_POS := 25;
End;
HIT_FLAG := False;
If ((Ord(TEST_CHOICE) - 48) = TARGET) Then
HIT_FLAG := True;
If (((PARAM_DATA.SOUND_REINFORCE = 1) And HIT_FLAG) Or
((PARAM_DATA.SOUND_REINFORCE = 2) And (HIT_FLAG)))
Then
Begin
Sound(1760);
Delay(1000);
NoSound;
Delay(500);
End;
If (((PARAM_DATA.SOUND_REINFORCE = 1) And (Not HIT_FLAG)) Or
((PARAM_DATA.SOUND_REINFORCE = 3) And (Not HIT_FLAG)))
Then Begin
Sound(300);
Delay(500);
Sound(277);
Delay(1000);
NoSound;
End;
If ((PARAM_DATA.VISUAL_REINFORCE = 1) Or
((PARAM_DATA.VISUAL_REINFORCE = 2) And (HIT_FLAG)) Or
((PARAM_DATA.VISUAL_REINFORCE = 3) And (Not HIT_FLAG)))
Then
Begin
Case SELECTS_RAND_NOS[TARGET] Of
1 : PutImage(X_POS,Y_POS,CARD_1^,0);
2 : PutImage(X_POS,Y_POS,CARD_2^,0);
3 : PutImage(X_POS,Y_POS,CARD_3^,0);
4 : PutImage(X_POS,Y_POS,CARD_4^,0);
5 : PutImage(X_POS,Y_POS,CARD_5^,0);
End; { Case }
Delay(1500);
End;
If (PARAM_DATA.SOUND_REINFORCE = 4) Then
Delay(1500);
D_TARGET := Char(TARGET + 48);
D_GUESS := TEST_CHOICE;
If HIT_FLAG Then D_HIT_MISS := 'H'
Else D_HIT_MISS := 'M';
D_COLOR_OF_CARD := PARAM_DATA.COLOR_OF_CARD;
D_SCREEN_DISPLAY1 := Char(SELECTS_RAND_NOS[1] + 48);
D_SCREEN_DISPLAY2 := Char(SELECTS_RAND_NOS[2] + 48);
D_SCREEN_DISPLAY3 := Char(SELECTS_RAND_NOS[3] + 48);
D_SCREEN_DISPLAY4 := Char(SELECTS_RAND_NOS[4] + 48);
D_SCREEN_DISPLAY5 := Char(SELECTS_RAND_NOS[5] + 48);
D_REINFORCE_VISUAL := Char(PARAM_DATA.VISUAL_REINFORCE + 48);
D_REINFORCE_SOUND := CHAR(PARAM_DATA.SOUND_REINFORCE + 48);
D_STYLE := PARAM_DATA.TYPE_TEST;
D_ELAPESED_SEC := ELAPESED_SEC;
INDEX := 1;
Repeat
If PARAM_DATA.GUESS_FILE_NAME[INDEX] <> '.' Then
Begin
Case INDEX Of
1: D_NAME1 := PARAM_DATA.GUESS_FILE_NAME[1];
2: D_NAME2 := PARAM_DATA.GUESS_FILE_NAME[2];
3: D_NAME3 := PARAM_DATA.GUESS_FILE_NAME[3];
4: D_NAME4 := PARAM_DATA.GUESS_FILE_NAME[4];
5: D_NAME5 := PARAM_DATA.GUESS_FILE_NAME[5];
6: D_NAME6 := PARAM_DATA.GUESS_FILE_NAME[6];
7: D_NAME7 := PARAM_DATA.GUESS_FILE_NAME[7];
8: D_NAME8 := PARAM_DATA.GUESS_FILE_NAME[8];
End;
End
Else
Begin
For INDEX2 := INDEX To 8 Do
Case INDEX2 Of
1: D_NAME1 := ' ';
2: D_NAME2 := ' ';
3: D_NAME3 := ' ';
4: D_NAME4 := ' ';
5: D_NAME5 := ' ';
6: D_NAME6 := ' ';
7: D_NAME7 := ' ';
8: D_NAME8 := ' ';
End;
INDEX := 8;
End;
INDEX := INDEX + 1;
Until (INDEX > 8);
WRITE_OK := True;
SAVESCORE(WRITE_OK,D_TARGET,D_GUESS,D_HIT_MISS,
D_COLOR_OF_CARD,
D_SCREEN_DISPLAY1,D_SCREEN_DISPLAY2,
D_SCREEN_DISPLAY3,D_SCREEN_DISPLAY4,
D_SCREEN_DISPLAY5,D_REINFORCE_SOUND,
D_REINFORCE_VISUAL,D_STYLE,D_CUR_YEAR,
D_CUR_MONTH,D_CUR_DAY,D_START_HOUR,
D_START_MIN,D_START_SEC,D_ELAPESED_SEC,
D_NAME1,D_NAME2,D_NAME3,D_NAME4,D_NAME5,
D_NAME6,D_NAME7,D_NAME8);
End; { If TEST CHOICE <> 'Q' }
If Not WRITE_OK Then
begin
TEST_CHOICE := 'Q';
TEST_SELECTION := 'Y';
MAIN_SELECTION := 'Q';
end;
ClearDevice;
Until ((TEST_CHOICE = 'Q') Or (TEST_CALL = 25));
TEST_SELECTION := 'Y'
End; {TEST}
Procedure PROPORTIONS;
{**********************************************************}
{** **}
{** PROPORTIONS **}
{** **}
{**********************************************************}
Var ANSWER : Char;
OKAY_FLAG : Boolean;
FOUND_FLAG : Boolean;
INDEX : Byte;
INDEX2 : Byte;
D_NAME1,D_NAME2,D_NAME3,D_NAME4 : Char;
D_NAME5,D_NAME6,D_NAME7,D_NAME8 : Char;
HIT_I_1,HIT_I_2,HIT_I_3,HIT_I_4,HIT_I_5: Word;
HIT_P_1,HIT_P_2,HIT_P_3,HIT_P_4,HIT_P_5: Word;
TRIAL_I_1,TRIAL_I_2,TRIAL_I_3,TRIAL_I_4,TRIAL_I_5: Word;
TRIAL_P_1,TRIAL_P_2,TRIAL_P_3,TRIAL_P_4,TRIAL_P_5: Word;
TIME_SHORT_HIT: Word;
TIME_LONG_HIT: Word;
TIME_SHORT_TRIAL: Word;
TIME_LONG_TRIAL: Word;
NUMBER_STRING: String[18];
TEST_STRING:String[18];
TOTAL_HITS,TOTAL_TRIALS : Word;
AVER_HIT, AVER_TRIAL,AVER_MISS,REAL_TEMP : Real;
TOTAL_ATTEMPTS, TOTAL_MISSES,HIT_RATIO,MISS_RATIO : Real;
CELL_1_H,CELL_2_H,CELL_3_H,CELL_4_H,CELL_5_H:Real;
CELL_1_T,CELL_2_T,CELL_3_T,CELL_4_T,CELL_5_T:Real;
CHI_SQUARE, SHORT_TIME, LONG_TIME : Real;
PROB_C, PROB_B ,CHI_SQ : Real;
Begin {ANALYSIS}
ClearDevice;
INDEX := 1;
Repeat
If PARAM_DATA.GUESS_FILE_NAME[INDEX] <> '.' Then
Begin
Case INDEX Of
1: D_NAME1 := PARAM_DATA.GUESS_FILE_NAME[1];
2: D_NAME2 := PARAM_DATA.GUESS_FILE_NAME[2];
3: D_NAME3 := PARAM_DATA.GUESS_FILE_NAME[3];
4: D_NAME4 := PARAM_DATA.GUESS_FILE_NAME[4];
5: D_NAME5 := PARAM_DATA.GUESS_FILE_NAME[5];
6: D_NAME6 := PARAM_DATA.GUESS_FILE_NAME[6];
7: D_NAME7 := PARAM_DATA.GUESS_FILE_NAME[7];
8: D_NAME8 := PARAM_DATA.GUESS_FILE_NAME[8];
End;
End
Else
Begin
For INDEX2 := INDEX To 8 Do
Case INDEX2 Of
1: D_NAME1 := ' ';
2: D_NAME2 := ' ';
3: D_NAME3 := ' ';
4: D_NAME4 := ' ';
5: D_NAME5 := ' ';
6: D_NAME6 := ' ';
7: D_NAME7 := ' ';
8: D_NAME8 := ' ';
End;
INDEX := 8;
End;
INDEX := INDEX + 1;
Until (INDEX > 8);
GET_RATIOS(HIT_I_1,HIT_I_2,HIT_I_3,HIT_I_4,HIT_I_5,
HIT_P_1,HIT_P_2,HIT_P_3,HIT_P_4,HIT_P_5,
TRIAL_I_1,TRIAL_I_2,TRIAL_I_3,TRIAL_I_4,TRIAL_I_5,
TRIAL_P_1,TRIAL_P_2,TRIAL_P_3,TRIAL_P_4,TRIAL_P_5,
TIME_SHORT_HIT,TIME_LONG_HIT,TIME_SHORT_TRIAL,
TIME_LONG_TRIAL,FOUND_FLAG,D_NAME1,D_NAME2,
D_NAME3,D_NAME4,D_NAME5,D_NAME6,D_NAME7,D_NAME8);
If FOUND_FLAG Then
Begin
USE_SMALL_FONT;
BOXES;
Str(HIT_I_1,NUMBER_STRING);
MoveTo(60,35);
OutText(NUMBER_STRING);
Str(HIT_I_2,NUMBER_STRING);
MoveTo(100,35);
OutText(NUMBER_STRING);
Str(HIT_I_3,NUMBER_STRING);
MoveTo(140,35);
OutText(NUMBER_STRING);
Str(HIT_I_4,NUMBER_STRING);
MoveTo(180,35);
OutText(NUMBER_STRING);
Str(HIT_I_5,NUMBER_STRING);
MoveTo(220,35);
OutText(NUMBER_STRING);
Str((TRIAL_I_1 - HIT_I_1),NUMBER_STRING);
MoveTo(60,55);
OutText(NUMBER_STRING);
Str((TRIAL_I_2 - HIT_I_2),NUMBER_STRING);
MoveTo(100,55);
OutText(NUMBER_STRING);
Str((TRIAL_I_3 - HIT_I_3),NUMBER_STRING);
MoveTo(140,55);
OutText(NUMBER_STRING);
Str((TRIAL_I_4 - HIT_I_4),NUMBER_STRING);
MoveTo(180,55);
OutText(NUMBER_STRING);
Str((TRIAL_I_5 - HIT_I_5),NUMBER_STRING);
MoveTo(220,55);
OutText(NUMBER_STRING);
TOTAL_HITS := HIT_I_1 + HIT_I_2 + HIT_I_3 + HIT_I_4 + HIT_I_5;
TOTAL_TRIALS :=
TRIAL_I_1 + TRIAL_I_2 + TRIAL_I_3 + TRIAL_I_4 + TRIAL_I_5;
TOTAL_MISSES := TOTAL_TRIALS - TOTAL_HITS;
HIT_RATIO := TOTAL_HITS / TOTAL_TRIALS;
MISS_RATIO := TOTAL_MISSES / TOTAL_TRIALS;
AVER_HIT := TRIAL_I_1 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_1_H := Sqr(Abs(HIT_I_1 - AVER_HIT)) / AVER_HIT
Else CELL_1_H := 0;
AVER_HIT := TRIAL_I_2 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_2_H := Sqr(Abs(HIT_I_2 - AVER_HIT)) / AVER_HIT
Else CELL_2_H := 0;
AVER_HIT := TRIAL_I_3 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_3_H := Sqr(Abs(HIT_I_3 - AVER_HIT)) / AVER_HIT
Else CELL_3_H := 0;
AVER_HIT := TRIAL_I_4 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_4_H := Sqr(Abs(HIT_I_4 - AVER_HIT)) / AVER_HIT
Else CELL_4_H := 0;
AVER_HIT := TRIAL_I_5 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_5_H := Sqr(Abs(HIT_I_5 - AVER_HIT)) / AVER_HIT
Else CELL_5_H := 0;
AVER_MISS := TRIAL_I_1 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_1_T := Sqr(Abs((TRIAL_I_1 - HIT_I_1) - AVER_MISS))
/ AVER_MISS
Else CELL_1_T := 0;
AVER_MISS := TRIAL_I_2 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_2_T := Sqr(Abs((TRIAL_I_2 - HIT_I_2) - AVER_MISS))
/ AVER_MISS
Else CELL_2_T := 0;
AVER_MISS := TRIAL_I_3 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_3_T := Sqr(Abs((TRIAL_I_3 - HIT_I_3) - AVER_MISS))
/ AVER_MISS
Else CELL_3_T := 0;
AVER_MISS := TRIAL_I_4 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_4_T := Sqr(Abs((TRIAL_I_4 - HIT_I_4) - AVER_MISS))
/ AVER_MISS
Else CELL_4_T := 0;
AVER_MISS := TRIAL_I_5 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_5_T := Sqr(Abs((TRIAL_I_5 - HIT_I_5) - AVER_MISS))
/ AVER_MISS
Else CELL_5_T := 0;
CHI_SQUARE := CELL_1_H + CELL_2_H + CELL_3_H + CELL_4_H + CELL_5_H +
CELL_1_T + CELL_2_T + CELL_3_T + CELL_4_T + CELL_5_T;
Str(CHI_SQUARE:6:3,REAL_STRING);
MoveTo( 255,5);
OutText('X = '+REAL_STRING);
MoveTo(262,0);
OutText('2');
MoveTo(255,15);
OutText('This has a ');
MoveTo(252,25);
OutText('Significance');
MoveTo(255,35);
PROB_C := 0;
CHISQUARE(PROB_C,CHI_SQUARE,4);
REAL_TEMP := PROB_C;
Str(REAL_TEMP:6:3,REAL_STRING);
OutText('= '+REAL_STRING);
MoveTo(255,45);
OutText('for your');
MoveTo(255,55);
OutText('proportion');
MoveTo(255,65);
OutText('by targets.');
Str(HIT_P_1,NUMBER_STRING);
MoveTo(60,90);
OutText(NUMBER_STRING);
Str(HIT_P_2,NUMBER_STRING);
MoveTo(100,90);
OutText(NUMBER_STRING);
Str(HIT_P_3,NUMBER_STRING);
MoveTo(140,90);
OutText(NUMBER_STRING);
Str(HIT_P_4,NUMBER_STRING);
MoveTo(180,90);
OutText(NUMBER_STRING);
Str(HIT_P_5,NUMBER_STRING);
MoveTo(220,90);
OutText(NUMBER_STRING);
Str((TRIAL_P_1 - HIT_P_1),NUMBER_STRING);
MoveTo(60,110);
OutText(NUMBER_STRING);
Str((TRIAL_P_2 - HIT_P_2),NUMBER_STRING);
MoveTo(100,110);
OutText(NUMBER_STRING);
Str((TRIAL_P_3 - HIT_P_3),NUMBER_STRING);
MoveTo(140,110);
OutText(NUMBER_STRING);
Str((TRIAL_P_4 - HIT_P_4),NUMBER_STRING);
MoveTo(180,110);
OutText(NUMBER_STRING);
Str((TRIAL_P_5 - HIT_P_5),NUMBER_STRING);
MoveTo(220,110);
OutText(NUMBER_STRING);
TOTAL_HITS := HIT_P_1 + HIT_P_2 + HIT_P_3 + HIT_P_4 + HIT_P_5;
TOTAL_TRIALS :=
TRIAL_P_1 + TRIAL_P_2 + TRIAL_P_3 + TRIAL_P_4 + TRIAL_P_5;
TOTAL_MISSES := TOTAL_TRIALS - TOTAL_HITS;
HIT_RATIO := TOTAL_HITS / TOTAL_TRIALS;
MISS_RATIO := TOTAL_MISSES / TOTAL_TRIALS;
AVER_HIT := TRIAL_P_1 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_1_H := Sqr(Abs(HIT_P_1 - AVER_HIT)) / AVER_HIT
Else CELL_1_H := 0;
AVER_HIT := TRIAL_P_2 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_2_H := Sqr(Abs(HIT_P_2 - AVER_HIT)) / AVER_HIT
Else CELL_2_H := 0;
AVER_HIT := TRIAL_P_3 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_3_H := Sqr(Abs(HIT_P_3 - AVER_HIT)) / AVER_HIT
Else cell_3_h := 0;
AVER_HIT := TRIAL_P_4 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_4_H := Sqr(Abs(HIT_P_4 - AVER_HIT)) / AVER_HIT
Else CELL_4_H := 0;
AVER_HIT := TRIAL_P_5 * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_5_H := Sqr(Abs(HIT_P_5 - AVER_HIT)) / AVER_HIT
Else CELL_5_H := 0;
AVER_MISS := TRIAL_P_1 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_1_T := Sqr(Abs((TRIAL_P_1 - HIT_P_1) - AVER_MISS))
/ AVER_MISS
Else CELL_1_T := 0;
AVER_MISS := TRIAL_P_2 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_2_T := Sqr(Abs((TRIAL_P_2 - HIT_P_2) - AVER_MISS))
/ AVER_MISS
Else CELL_2_T := 0;
AVER_MISS := TRIAL_P_3 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_3_T := Sqr(Abs((TRIAL_P_3 - HIT_P_3) - AVER_MISS))
/ AVER_MISS
Else CELL_3_T := 0;
AVER_MISS := TRIAL_P_4 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_4_T := Sqr(Abs((TRIAL_P_4 - HIT_P_4) - AVER_MISS))
/ AVER_MISS
Else CELL_4_T := 0;
AVER_MISS := TRIAL_P_5 * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_5_T := Sqr(Abs((TRIAL_P_5 - HIT_P_5) - AVER_MISS))
/ AVER_MISS
Else CELL_5_T := 0;
CHI_SQUARE := CELL_1_H + CELL_2_H + CELL_3_H + CELL_4_H + CELL_5_H +
CELL_1_T + CELL_2_T + CELL_3_T + CELL_4_T + CELL_5_T;
Str(CHI_SQUARE:6:3,REAL_STRING);
MoveTo( 255,95);
OutText('X = '+REAL_STRING);
MoveTo(262,90);
OutText('2');
MoveTo(255,105);
OutText('has a ');
MoveTo(252,115);
OutText('Significance');
PROB_C := 0;
CHISQUARE(PROB_C,CHI_SQUARE,4);
Real_TEMP := PROB_C;
Str(REAL_TEMP:6:3,REAL_STRING);
MoveTo(255,125);
OUTText('= '+REAL_STRING);
MoveTo(255,135);
OutText('for your');
MoveTo(255,145);
OutText('proportion');
MoveTo(255,155);
OutText('by their ');
MoveTo(255,165);
OutText('positions.');
Str(TIME_SHORT_HIT,NUMBER_STRING);
MoveTo(60,150);
OutText(NUMBER_STRING);
Str(TIME_LONG_HIT,NUMBER_STRING);
MoveTo(100,150);
OutText(NUMBER_STRING);
Str((TIME_SHORT_TRIAL-TIME_SHORT_HIT),NUMBER_STRING);
MoveTo(60,170);
OutText(NUMBER_STRING);
Str((TIME_LONG_TRIAL-TIME_LONG_HIT),NUMBER_STRING);
MoveTo(100,170);
OutText(NUMBER_STRING);
TOTAL_HITS := TIME_SHORT_HIT + TIME_LONG_HIT;
TOTAL_TRIALS := TIME_SHORT_TRIAL + TIME_LONG_TRIAL;
HIT_RATIO := TOTAL_HITS / TOTAL_TRIALS;
TOTAL_MISSES := TOTAL_TRIALS - TOTAL_HITS;
MISS_RATIO := TOTAL_MISSES / TOTAL_TRIALS;
AVER_HIT := TIME_SHORT_TRIAL * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_1_H := Sqr(Abs(TIME_SHORT_HIT - AVER_HIT)) / AVER_HIT
Else CELL_1_H := 0;
AVER_HIT := TIME_LONG_TRIAL * HIT_RATIO;
If AVER_HIT > 0 Then
CELL_2_H := Sqr(Abs(TIME_LONG_HIT - AVER_HIT)) / AVER_HIT
Else CELL_2_H := 0;
AVER_MISS := TIME_SHORT_TRIAL * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_1_T := Sqr(Abs((TIME_SHORT_TRIAL - TIME_SHORT_HIT)
- AVER_miss)) / AVER_MISS
Else CELL_1_T := 0;
AVER_MISS := TIME_LONG_TRIAL * MISS_RATIO;
If AVER_MISS > 0 Then
CELL_2_T := Sqr(Abs((TIME_LONG_TRIAL - TIME_LONG_HIT)
- AVER_MISS)) / AVER_MISS
Else CELL_2_T := 0;
CHI_SQUARE := CELL_1_H + CELL_2_H + CELL_1_T + CELL_2_T;
Str(CHI_SQUARE:6:3,REAL_STRING);
MoveTo( 135,135);
OutText('X = '+REAL_STRING);
MoveTo(145,130);
OutText('2');
MoveTo(215,135);
OutText('has a');
PROB_C := 0;
CHISQUARE(PROB_C,CHI_SQUARE,1);
REAL_TEMP := PROB_C;
Str(REAL_TEMP:6:3,REAL_STRING);
MoveTo(135,145);
OutText('Significance ');
MoveTo(135,155);
OutText('= '+REAL_STRING+' for the');
MoveTo(135,165);
OutText('long vs short times ');
MoveTo(135,175);
OutText('you''ve taken.');
OKAY_FLAG := False;
Repeat
ANSWER := UpCase(readkey);
If ANSWER In ['Q'] Then
OKAY_FLAG := True
Else
ERROR(' Must be Q ');
Until OKAY_FLAG;
End {** IF FOUND FLAG **}
End; {ANALYSIS}
Procedure ANALYSIS(Var ANALYSIS_SELECTION : Char);
{**********************************************************}
{** **}
{** ANALYSIS **}
{** **}
{**********************************************************}
Var TRIALS: Word;
HITS : Word;
ARGUMENT : Real;
TEST_HITS : LongInt;
TEST_N_P : LongInt;
PROB_B : Real;
STRING3 : String[3];
STRING2 : String[2];
TRIALS_STRING : String[5];
HITS_STRING : String[5];
PER_CENT_STR : String[2];
WORK_PROB : Real;
INT_PROB : Integer;
TEMP_PROB : Real;
X_OVER_N : Real;
HIT_RATIO : Real;
MISS_RATIO : Real;
AVER_HIT : Real;
AVER_MISS : Real;
CELL_1_H, CELL_2_H,CELL_1_T,CELL_2_T : Real;
CHI_SQUARE : Real;
ANSWER : Char;
HIGH_HITS : Integer;
LOW_HITS : Integer;
TOTAL_HITS : Real;
TOTAL_MISSES : Real;
TOTAL_TRIALS : Real;
PROB_C : Real;
OKAY_FLAG : Boolean;
FOUND_FLAG : Boolean;
INDEX : Byte;
INDEX2 : Byte;
D_NAME1 : Char;
D_NAME2 : Char;
D_NAME3 : Char;
D_NAME4 : Char;
D_NAME5 : Char;
D_NAME6 : Char;
D_NAME7 : Char;
D_NAME8 : Char;
Begin {ANALYSIS}
ClearDevice;
INDEX := 1;
Repeat
If PARAM_DATA.GUESS_FILE_NAME[INDEX] <> '.' Then
Begin
Case INDEX Of
1: D_NAME1 := PARAM_DATA.GUESS_FILE_NAME[1];
2: D_NAME2 := PARAM_DATA.GUESS_FILE_NAME[2];
3: D_NAME3 := PARAM_DATA.GUESS_FILE_NAME[3];
4: D_NAME4 := PARAM_DATA.GUESS_FILE_NAME[4];
5: D_NAME5 := PARAM_DATA.GUESS_FILE_NAME[5];
6: D_NAME6 := PARAM_DATA.GUESS_FILE_NAME[6];
7: D_NAME7 := PARAM_DATA.GUESS_FILE_NAME[7];
8: D_NAME8 := PARAM_DATA.GUESS_FILE_NAME[8];
End;
End
Else
Begin
For INDEX2 := INDEX To 8 Do
Case INDEX2 Of
1: D_NAME1 := ' ';
2: D_NAME2 := ' ';
3: D_NAME3 := ' ';
4: D_NAME4 := ' ';
5: D_NAME5 := ' ';
6: D_NAME6 := ' ';
7: D_NAME7 := ' ';
8: D_NAME8 := ' ';
End;
INDEX := 8;
End;
INDEX := INDEX + 1;
Until (INDEX > 8);
TRIALS := 0;
HITS := 0;
GETSCORE(HITS,TRIALS,FOUND_FLAG,D_NAME1,D_NAME2,
D_NAME3,D_NAME4,D_NAME5,D_NAME6,D_NAME7,D_NAME8);
If FOUND_FLAG Then
Begin
PROB_B := 0;
USE_SMALL_FONT;
MoveTo(0,0);
Str(TRIALS,TRIALS_STRING);
OutText('You have made '+TRIALS_STRING+' attemps');
MoveTo(0,15);
Str(HITS,HITS_STRING);
WORK_REAL := HITS / TRIALS;
Str(WORK_REAL:6:3,REAL_STRING);
OutText(
'You have been successful '+HITS_STRING+' times; a '+REAL_string+' ratio');
MoveTo(0,30);
TEST_HITS := HITS * 10;
TEST_N_P := TRIALS * 2;
If (TEST_N_P < TEST_HITS) Then
Begin
OutText('To have '+HITS_STRING+' hits or more out of '+
TRIALS_STRING+' has a');
HITS := HITS - 1;
BINOMIAL(PROB_B,TRIALS,HITS);
PROB_B := 1.0 - PROB_B;
HITS := HITS + 1;
End;
If ((TEST_N_P > TEST_HITS) Or
(TEST_N_P = TEST_HITS)) Then
Begin
OutText('To have '+HITS_STRING+' hits or less out of '+
TRIALS_STRING+' has a');
BINOMIAL(PROB_B,TRIALS,HITS);
End;
USE_ROMAN_FONT;
Str(PROB_B:5:3,REAL_STRING);
MoveTo(0,45);
OutText('Probability of '+REAL_STRING);
USE_SMALL_FONT;
{*** Compute CHI-SQUARE ***}
TOTAL_HITS := (TRIALS * 0.2) + HITS;
TOTAL_TRIALS := TRIALS * 2;
HIT_RATIO := TOTAL_HITS / TOTAL_TRIALS;
TOTAL_MISSES := (TRIALS * 0.8) +
TRIALS - HITS;
MISS_RATIO := TOTAL_MISSES / TOTAL_TRIALS;
If HIT_RATIO > 0 Then Begin
AVER_HIT := TRIALS * HIT_RATIO;
CELL_1_H := Sqr(Abs((0.2 * TRIALS) - AVER_HIT)) / AVER_HIT;
CELL_2_H := Sqr(Abs(hits - AVER_HIT)) / AVER_HIT;
End
Else Begin
CELL_1_H := 0;
CELL_2_H := 0;
End;
If MISS_RATIO > 0 Then Begin
AVER_MISS := TRIALS * MISS_RATIO;
CELL_1_T := Sqr(Abs((0.8 * TRIALS) - AVER_MISS)) / AVER_MISS;
CELL_2_T := Sqr(Abs((TRIALS - HITS) - AVER_MISS)) / AVER_MISS;
End
Else Begin
CELL_1_T := 0;
CELL_2_T := 0;
End;
CHI_SQUARE := CELL_1_H + CELL_2_H + CELL_1_T + CELL_2_T;
Str(CHI_SQUARE:6:3,REAL_STRING);
MoveTo(0,80);
OutText('The Chi-Square test shows:');
MoveTo( 0,100);
OutText('X = '+REAL_STRING);
MoveTo(10,95);
OutText('2');
PROB_C := 0;
CHISQUARE(PROB_C,CHI_SQUARE,1);
Str(PROB_C:6:3,REAL_STRING);
MoveTo(0,120);
OutText('You have a '+real_string+' significance');
MoveTo(40,140);
OutText('for this test of your');
MoveTo(170,134);
USE_ROMAN_FONT;
If ((HITS / TRIALS) > 0.2 ) Then
OutText('ESP')
Else
OutText('Psi-missing');
USE_SMALL_FONT;
MoveTo(0,180);
OutText(' Enter Q to QUIT Analysis; enter M for MORE Analysis');
OKAY_FLAG := False;
Repeat
ANALYSIS_SELECTION := UpCase(readkey);
If ANALYSIS_SELECTION In ['Q','M'] Then
OKAY_FLAG := True
Else
ERROR(' Must be Q or M');
Until OKAY_FLAG;
If ANALYSIS_SELECTION = 'M' Then
PROPORTIONS;
If ANALYSIS_SELECTION = 'Q' Then
ANALYSIS_SELECTION := 'Y';
End {** IF FOUND FLAG **}
Else
ANALYSIS_SELECTION := 'Y';
End; {ANALYSIS}
{**********************************************************}
{** **}
{** PROCEDURE MAIN_MENU displays the main menu and **}
{** accepts a choice **}
{** **}
{**********************************************************}
Var CHANGE_SELECTION : Char;
TEST_SELECTION : Char;
ANALYSIS_SELECTION : Char;
OKAY_FLAG : Boolean;
Begin { main_menu }
If MAIN_SELECTION <> 'X' Then
ClearDevice;
PutImage(0,0,MENU_SCREEN^,0);
CHANGE_SELECTION := 'X';
TEST_SELECTION := 'X';
ANALYSIS_SELECTION := 'X';
OKAY_FLAG := False;
Repeat
MAIN_SELECTION := UpCase(readkey);
If MAIN_SELECTION In ['I','C','T','A','Q'] Then
OKAY_FLAG := True
Else
ERROR(' Must be I C T A or Q ');
Until OKAY_FLAG;
Case MAIN_SELECTION Of
'I' : Begin
ClearDevice;
USE_ROMAN_FONT;
MoveTo(0,0);
OutText(' ESPTEST');
USE_SMALL_FONT;
PROGRAM_INFO;
End;
'C' : Begin
While CHANGE_SELECTION <> 'Q' Do Begin
CHANGE_DEFAULTS(CHANGE_SELECTION);
End;
End;
'T' : Begin
While TEST_SELECTION <> 'Y' Do Begin
TEST(TEST_SELECTION);
End;
End;
'A' : Begin
While ANALYSIS_SELECTION <> 'Y' Do Begin
ANALYSIS(ANALYSIS_SELECTION);
End;
End;
'Q' : Begin
End;
End;
End; { Main_menu }
{*********************************************************}
{** **}
{** This is the main program **}
{** **}
{*********************************************************}
Var MAIN_SELECTION: Char;
Begin {ESP_TEST}
INITIALIZE;
TITLE;
MAKE_MENU;
GETIMAGE(0,0,26,26,SELECT_1^);
GETIMAGE(49,0,75,26,SELECT_2^);
GETIMAGE(98,0,124,26,SELECT_3^);
GETIMAGE(148,0,174,26,SELECT_4^);
GETIMAGE(197,0,223,26,SELECT_5^);
USE_ROMAN_FONT;
MoveTo(50,35);
OutText('I Information');
MoveTo(50,55);
OutText('C Change defaults');
MoveTo(50,75);
OutText('T Test');
MoveTo(50,95);
OutText('A Analysis');
MoveTo(50,115);
OutText('Q Quit');
GetImage(0,0,319,199,MENU_SCREEN^);
MAIN_SELECTION := 'X';
While MAIN_SELECTION <> 'Q' Do
Begin
MAIN_MENU(MAIN_SELECTION);
End;
CloseGraph;
RestoreCRTMode;
End. {ESP_TEST}